home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / oobr / br-objc.el < prev    next >
Encoding:
Text File  |  1995-05-05  |  14.2 KB  |  392 lines
  1. ;;!emacs
  2. ;;
  3. ;; FILE:         br-objc.el
  4. ;; SUMMARY:      Support routines for Objective-C inheritance browsing.
  5. ;; USAGE:        GNU Emacs Lisp Library
  6. ;; KEYWORDS:     c, oop, tools
  7. ;;
  8. ;; AUTHOR:       Bob Weiner
  9. ;; ORG:          Motorola Inc.
  10. ;;
  11. ;; ORIG-DATE:     7-Dec-89
  12. ;; LAST-MOD:      3-May-95 at 17:32:15 by Bob Weiner
  13. ;;
  14. ;; Copyright (C) 1989-1995  Free Software Foundation, Inc.
  15. ;; See the file BR-COPY for license information.
  16. ;;
  17. ;; This file is part of the OO-Browser.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;;
  21. ;;   See 'objc-class-def-regexp' for regular expression that matches class
  22. ;;   definitions.
  23. ;;            
  24. ;; DESCRIP-END.
  25.  
  26. ;;; ************************************************************************
  27. ;;; Other required Elisp libraries
  28. ;;; ************************************************************************
  29.  
  30. (mapcar 'require '(br-lib br-c-ft))
  31.  
  32. ;;; ************************************************************************
  33. ;;; Public variables
  34. ;;; ************************************************************************
  35.  
  36. (defvar objc-lib-search-dirs nil
  37.   "List of directories below which Objective-C Library source files are found.
  38. Subdirectories of Library source are also searched.  A Library is a stable
  39. group of classes.")
  40.  
  41. (defvar objc-sys-search-dirs nil
  42.   "List of directories below which Objective-C System source files are found.
  43. Subdirectories of System source are also searched.  A System class is one
  44. that is not yet reusable and is likely to change before release.")
  45.  
  46. (defconst objc-narrow-view-to-class nil
  47.  "*Non-nil means narrow buffer to just the matching class definition when displayed.")
  48.  
  49. ;;; ************************************************************************
  50. ;;; Public functions
  51. ;;; ************************************************************************
  52.  
  53. (defun objc-get-classes-from-source (filename &optional skip-tags
  54.                           skip-tags-cleanup)
  55.   "Scans FILENAME and returns cons of class list with parents-class alist.
  56. Assumes file existence and readability have already been checked.
  57.    With optional SKIP-TAGS non-nil, does not compute and store lookup tags
  58. for feature definitions.  If SKIP-TAGS is nil, normally a cleanup
  59. routine is called after scanning the features.  SKIP-TAGS-CLEANUP
  60. non-nil suppresses this action."
  61.   (let ((no-kill (get-file-buffer filename))
  62.     (parents-and-class)
  63.     (signatures)
  64.     class class-of-category class-separator class-type
  65.     classes category def-match-data in-comment-flag parent-list
  66.     protocol-list)
  67.     (if no-kill
  68.     (set-buffer no-kill)
  69.       (funcall br-view-file-function filename))
  70.     (save-excursion
  71.       (save-restriction
  72.     (widen)
  73.     (goto-char (point-min))
  74.     (if skip-tags
  75.         nil
  76.       ;; Get all method definitions within this file.
  77.       (setq signatures (objc-scan-features))
  78.       (goto-char (point-min)))
  79.     ;; Search for class or protocol interface specification.
  80.     (while (re-search-forward objc-class-def-regexp nil t)
  81.       (setq class nil class-type nil
  82.         category nil parent-list nil protocol-list nil
  83.         def-match-data (match-data))
  84.       ;;
  85.       ;; If definition is within a C comment, ignore it.
  86.       ;; Regexp used for matching a def precludes any "//"
  87.       ;; comment.
  88.       (if (setq in-comment-flag
  89.             (and (c-within-comment-p) (search-forward "*/" nil t)))
  90.           nil
  91.         (store-match-data def-match-data)
  92.         (setq class-type (buffer-substring
  93.                   (match-beginning objc-class-def-type-grpn)
  94.                   (match-end objc-class-def-type-grpn))
  95.           class-separator
  96.           (if (match-beginning objc-class-def-separator-grpn)
  97.               (buffer-substring
  98.                (match-beginning objc-class-def-separator-grpn)
  99.                (match-end objc-class-def-separator-grpn)))))
  100.       ;;
  101.       (cond (in-comment-flag) ;; Ignore
  102.         ;;
  103.         ((string-equal class-type "@interface")
  104.          ;; Class or category definition
  105.          (setq class (buffer-substring
  106.                   (match-beginning objc-class-name-grpn)
  107.                   (match-end objc-class-name-grpn)))
  108.          (cond ((null class-separator)
  109.             ;; top class definition without any protocols,
  110.             ;; nothing more to do
  111.             )
  112.                ((string-equal class-separator ":")
  113.             ;; class definition with parent
  114.             (if (re-search-forward objc-parent-regexp nil t)
  115.                 (setq parent-list
  116.                   (list (buffer-substring
  117.                      (match-beginning
  118.                       objc-parent-name-grpn)
  119.                      (match-end objc-parent-name-grpn))))
  120.               (error "(objc-get-classes-from-source): '%s' parent definition is invalid."
  121.                  class))
  122.             ;; Check if class conforms to protocol list
  123.             (if (and (null skip-tags) (= (following-char) ?\<))
  124.                 (setq protocol-list (objc-scan-protocol-list))))
  125.                ;;
  126.                ((string-equal class-separator "\(")
  127.             ;; class category definition
  128.             (if (null skip-tags)
  129.                 ;; Check if class conforms to protocol list
  130.                 (progn
  131.                   (skip-chars-forward " \t\n\r")
  132.                   (setq class-of-category
  133.                     (buffer-substring
  134.                      (match-beginning objc-class-name-grpn)
  135.                      (match-end objc-class-name-grpn))
  136.                     category
  137.                     (if (looking-at objc-identifier)
  138.                     (progn
  139.                       (goto-char (match-end 0))
  140.                       (skip-chars-forward "\) \t\n\r")
  141.                       (concat
  142.                        "\(" (buffer-substring
  143.                          (match-beginning
  144.                           objc-identifier-grpn)
  145.                          (match-end 
  146.                           objc-identifier-grpn))
  147.                        "\)"))
  148.                       ;; If get here, there is a problem.
  149.                       (error "(objc-get-classes-from-source): '%s' class contains invalid category () delimiters"))
  150.                     class (concat class-of-category category)
  151.                     signatures
  152.                     ;; Add this category def to the default
  153.                     ;; categories class.
  154.                     (cons (objc-feature-normalize
  155.                        ;; Yes, this net line should be
  156.                        ;; (category)class-of-category.
  157.                        (concat category class-of-category)
  158.                        objc-default-category-class)
  159.                     ;; Add a category tag to
  160.                     ;; class-of-category.
  161.                       (cons (objc-feature-normalize
  162.                          category
  163.                          class-of-category)
  164.                         signatures)))
  165.                   ;; Check if category conforms to protocol list
  166.                   (if (= (following-char) ?\<)
  167.                   (setq protocol-list
  168.                     (objc-scan-protocol-list))))))
  169.                ;;
  170.                ((string-equal class-separator "\<")
  171.             ;; top class definition conforming to protocols
  172.             (if (null skip-tags)
  173.                 (setq protocol-list (objc-scan-protocol-list))))
  174.                ;;
  175.                ;; If get here, there is a bug, so signal an error.
  176.                (t (error "(objc-get-classes-from-source): '%s' class uses '%s' unhandled definition separator"
  177.                  class class-separator))))
  178.         ;;
  179.         (t
  180.          ;;
  181.          ;; Protocol definition
  182.          ;;
  183.          ;;   Record '<'protocol-name '>' as a class along with its
  184.          ;;   parent protocols, if any.
  185.          ;;   If not skip-tags, add the protocol's method
  186.          ;;   *declarations* as feature tags.
  187.          (setq class (concat "<"
  188.                      (buffer-substring
  189.                       (match-beginning objc-class-name-grpn)
  190.                       (match-end objc-class-name-grpn))
  191.                      ">")
  192.                parent-list
  193.                (if (string-equal class-separator "\<")
  194.                (objc-scan-protocol-list)))
  195.          (if (null skip-tags)
  196.              (setq signatures
  197.                ;; Add this protocol def to the default protocols
  198.                ;; class.
  199.                (cons (objc-feature-normalize
  200.                   class objc-default-protocol-class)
  201.                  signatures)))))
  202.       (if (null class-type)
  203.           nil
  204.         (if class (setq classes (cons class classes)
  205.                 parents-and-class
  206.                 (cons (cons parent-list class)
  207.                   parents-and-class)))
  208.         (if protocol-list
  209.         ;; record all of class' protocols as tags
  210.         (setq signatures
  211.               (nconc signatures
  212.                  (mapcar
  213.                   (function (lambda (protocol)
  214.                       (objc-feature-normalize
  215.                        protocol class)))
  216.                   protocol-list))))))))
  217.     (if skip-tags
  218.     nil
  219.       (objc-get-feature-tags buffer-file-name signatures)
  220.       (or skip-tags-cleanup (br-feature-tags-save)))
  221.     (or no-kill (kill-buffer (current-buffer)))
  222.     (cons classes (delq nil parents-and-class))))
  223.  
  224. (defun objc-get-parents-from-source (filename class-name)
  225.   "Scan source in FILENAME and return list of parents of CLASS-NAME.
  226. Assume file existence has already been checked."
  227.     (or (null class-name)
  228.     (let ((br-view-file-function 'br-insert-file-contents))
  229.       (car (car (br-rassoc
  230.               class-name
  231.               (cdr (objc-get-classes-from-source
  232.                  filename t))))))))
  233.  
  234. (defun objc-select-path (paths-htable-elt &optional feature-p)
  235.   "Select proper pathname from PATHS-HTABLE-ELT based upon value of optional FEATURE-P.
  236. Selection is between path of class definition and path for features associated
  237. with the class."
  238.   (let ((elt (cdr paths-htable-elt)))
  239.     (if (consp elt) 
  240.     (if feature-p (cdr elt) (car elt))
  241.       ;; Both paths are the same.
  242.       elt)))
  243.  
  244. (defun objc-set-case (type)
  245.   "Return string TYPE identifier for use as a class name."
  246.   type)
  247.  
  248. (defun objc-set-case-type (class-name)
  249.   "Return string CLASS-NAME for use as a type identifier."
  250.   class-name)
  251.  
  252. (defun objc-to-class-end ()
  253.   "Assuming point is at start of class, move to start of line after end of class."
  254.   (interactive)
  255.   (condition-case ()
  256.       (forward-list)
  257.     (error (progn (or (re-search-forward "^}" nil t)
  258.               (goto-char (point-max))))))
  259.   (forward-line 1))
  260.  
  261. (defun objc-to-comments-begin ()
  262.   "Skip back from current point past any preceding Objective-C comments.
  263. Presumes no \"/*\" strings are nested within multi-line comments."
  264.   (let ((opoint))
  265.     (while
  266.     (progn (setq opoint (point))
  267.            ;; To previous line
  268.            (if (= 0 (forward-line -1))
  269.            (cond
  270.              ;; If begins with "//" or ends with "*/", then is a comment.
  271.              ((looking-at "[ \t]*\\(//\\|$\\)"))
  272.              ((looking-at ".*\\*/[ \t]*$")
  273.               (progn (end-of-line)
  274.                  (search-backward "/*" nil t)))
  275.              (nil)))))
  276.     (goto-char opoint)
  277.     ;; Skip past whitespace
  278.     (skip-chars-forward " \t\n")
  279.     (beginning-of-line)))
  280.  
  281. ;;; ************************************************************************
  282. ;;; Private variables
  283. ;;; ************************************************************************
  284.  
  285. (defconst objc-class-keyword
  286.   "\\(@interface\\|@protocol\\)[ \t\n]+"
  287.   "Keyword regexp preceding an Objective-C class or protocol definition.
  288. Type of definition is indicated by grouping 'objc-class-def-type-grpn'.")
  289.  
  290. (defconst objc-class-def-type-grpn 1)
  291.  
  292. (defconst objc-class-name-before
  293.   (concat "^[ \t]*" objc-class-keyword)
  294.   "Regexp preceding the class name in a class definition.")
  295.  
  296. (defconst objc-class-name-after
  297.   "\\([ \t\n]+//.*[\n]\\)*[ \t\n]*\\([:\<\(]\\)?"
  298.   "Regexp following the class name in a class definition.")
  299.  
  300. (defconst objc-interface-before
  301.   "^[ \t]*\\(@interface\\)[ \t\n]+"
  302.   "Regexp preceding the class name in a non-protocol class definition.")
  303.  
  304. (defconst objc-implementation-before
  305.   "^[ \t]*\\(@implementation\\)[ \t\n]+"
  306.   "Regexp preceding the class name in a class method definition section.")
  307.  
  308. (defconst objc-protocol-before
  309.   "^[ \t]*\\(@protocol\\)[ \t\n]+"
  310.   "Regexp preceding the protocol name in a formal protocol definition.")
  311.  
  312. (defconst objc-identifier-chars "_a-zA-Z0-9"
  313.   "String of chars and char ranges that may be used within an Objective-C identifier.")
  314.  
  315. (defconst objc-identifier
  316.   (concat "\\([_a-zA-Z][" objc-identifier-chars "]*\\)")
  317.   "Regular expression matching an Objective-C identifier.
  318. The identifier is grouping 'objc-identifier-grpn'.")
  319.  
  320. (defconst objc-identifier-grpn 1)
  321.  
  322. (defconst objc-class-def-regexp
  323.   (concat objc-class-name-before objc-identifier objc-class-name-after)
  324.   "Regular expression used to match to class definitions in source text.
  325. Type of definition is indicated by grouping 'objc-class-def-type-grpn'.
  326. Class name identifier is grouping 'objc-class-name-grpn'.  Entire grouped
  327. expression ends with one of the following (optional grouping
  328. 'objc-class-def-separator-grpn'):
  329.   a ':', indicating that class inherits from parent class following the colon;
  330.   a '\(', indicating a class category definition;
  331.   a '<', indicating protocols to which class conforms;
  332.   no grouping match, indicating that this is a root class with no parent.")
  333.  
  334. (defconst objc-class-def-separator-grpn 4)
  335.  
  336. (defconst objc-lang-prefix "objc-"
  337.  "Prefix string that starts \"br-objc.el\" symbol names.")
  338.  
  339. (defconst objc-parent-regexp
  340.   (concat "[ \t\n]*" objc-identifier "\\([ \t\n]+//.*[\n]\\)?[ \t\n]*")
  341.   "Parent identifier is grouping 'objc-parent-name-grpn'.")
  342.  
  343. (defconst objc-parent-name-grpn 1)
  344.  
  345. (defconst objc-file-dir-regexp "^[^.~#].*[^.~#]$"
  346.   "Regexp that ignores extraneous non-source files and directories.")
  347.  
  348. (defconst objc-src-file-regexp ".\\.[hcmHCM]$"
  349.   "Regular expression matching a unique part of Objective-C source or header file name and no others.")
  350.  
  351. (defvar objc-children-htable nil
  352.   "Htable whose elements are of the form: (LIST-OF-CHILD-CLASSES . CLASS-NAME).
  353. Used to traverse Objective-C inheritance graph.  'br-build-children-htable' builds
  354. this list.")
  355. (defvar objc-parents-htable nil
  356.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  357. Used to traverse Objective-C inheritance graph.  'br-build-parents-htable' builds
  358. this list.")
  359. (defvar objc-paths-htable nil
  360.   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
  361. FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
  362. 'br-build-paths-htable' builds this list.")
  363.  
  364.  
  365. (defvar objc-lib-parents-htable nil
  366.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  367. Only classes from stable software libraries are used to build the list.")
  368. (defvar objc-lib-paths-htable nil
  369.   "Htable whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
  370. FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
  371. Only classes from stable software libraries are used to build the list.")
  372.  
  373. (defvar objc-sys-parents-htable nil
  374.   "Htable whose elements are of the form: (LIST-OF-PARENT-CLASSES . CLASS-NAME).
  375. Only classes from systems that are likely to change are used to build the list.")
  376. (defvar objc-sys-paths-htable nil
  377.   "Alist whose elements are of the form: (LIST-OF-CLASS-NAMES . FILE-PATH).
  378. FILE-PATH gives the location of classes found in LIST-OF-CLASS-NAMES.
  379. Only classes from systems that are likely to change are used to build the
  380. list.")
  381.  
  382. (defvar objc-lib-prev-search-dirs nil
  383.   "Used to check if 'objc-lib-classes-htable' must be regenerated.")
  384. (defvar objc-sys-prev-search-dirs nil
  385.   "Used to check if 'objc-sys-classes-htable' must be regenerated.")
  386.  
  387. (defvar objc-env-spec nil
  388.   "Non-nil value means Environment specification has been given but not yet built.
  389. Nil means current Environment has been built, though it may still require updating.")
  390.  
  391. (provide 'br-objc)
  392.